home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / tooltips / HintsU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-01-25  |  4.8 KB  |  171 lines
  1. unit HintsU;
  2. {$ifdef Ver80} { Delphi 1.0x }
  3.   {$define DelphiLessThan3}
  4. {$endif}
  5. {$ifdef Ver90} { Delphi 2.0x }
  6.   {$define DelphiLessThan3}
  7. {$endif}
  8. {$ifdef Ver93} { C++ Builder 1.0x }
  9.   {$define DelphiLessThan3}
  10. {$endif}
  11.  
  12. interface
  13.  
  14. uses
  15.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  16.   Dialogs, StdCtrls, Mask, DBCtrls, Db, DBTables, ExtCtrls;
  17.  
  18. type
  19.   TForm1 = class(TForm)
  20.     btnExit: TButton;
  21.     DBEdit1: TDBEdit;
  22.     DBEdit2: TDBEdit;
  23.     DBEdit3: TDBEdit;
  24.     DBEdit4: TDBEdit;
  25.     Table1: TTable;
  26.     DataSource1: TDataSource;
  27.     DBNavigator1: TDBNavigator;
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure FormResize(Sender: TObject);
  30.     procedure btnExitClick(Sender: TObject);
  31.     procedure DBEditEnter(Sender: TObject);
  32.     procedure DBEditExit(Sender: TObject);
  33.   private
  34.     HintWnd: THintWindow;
  35.     Control: TControl;
  36.     procedure ActivateOnOff(Sender: TObject);
  37.     function CalcHintRect(MaxWidth: Integer;
  38.       const AHint: string; HintWnd: THintWindow): TRect;
  39.     function CalcHintTopLeft(Control: TControl): TPoint;
  40.     procedure MoveControl(Control: TWinControl; ShowControl: Boolean);
  41.     procedure WMMove(var Msg: TWMMove);
  42.       message wm_Move;
  43.   public
  44.     { Public declarations }
  45.   end;
  46.  
  47. var
  48.   Form1: TForm1;
  49.  
  50. implementation
  51.  
  52. {$R *.DFM}
  53.  
  54. procedure TForm1.ActivateOnOff(Sender: TObject);
  55.  
  56.   {$ifdef DelphiLessThan3}
  57.   function ForegroundTask: Boolean;
  58.   begin
  59.     { Does the active window map onto some object in this app? }
  60.     Result := FindControl(GetActiveWindow) <> nil
  61.   end;
  62.   {$endif}
  63.  
  64. begin
  65.   if Assigned(Control) then
  66.     { If we lost focus, hide the tooltip. If we gain focus, show it }
  67.     MoveControl(HintWnd, ForegroundTask)
  68. end;
  69.  
  70. function TForm1.CalcHintRect(MaxWidth: Integer;
  71.   const AHint: string; HintWnd: THintWindow): TRect;
  72. {$ifdef DelphiLessThan3}
  73. var
  74.   Buf: array[0..511] of Char;
  75. begin
  76.   Result := Rect(0, 0, MaxWidth, 0);
  77.   { Ask Windows to do the hard calculation work }
  78.   DrawText(HintWnd.Canvas.Handle, StrPCopy(Buf, AHint), -1, Result,
  79.     DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  80.   { Add some breathing room }
  81.   Inc(Result.Right, 6);
  82.   Inc(Result.Bottom, 2);
  83. {$else}
  84. begin
  85.   { Delphi 3+ makes this method available }
  86.   Result := HintWnd.CalcHintRect(Screen.Width, AHint, nil)
  87. {$endif}
  88. end;
  89.  
  90. function TForm1.CalcHintTopLeft(Control: TControl): TPoint;
  91. const
  92.   HintOffset = 4;
  93. begin
  94.   { Where should it go? }
  95.   Result := Point(Control.Left + HintOffset, Control.Top + Control.Height);
  96.   Result := ClientToScreen(Result);
  97. end;
  98.  
  99. { Move hint, and hide/show it as specified }
  100. procedure TForm1.MoveControl(Control: TWinControl; ShowControl: Boolean);
  101. const
  102.   Visibility: array[Boolean] of Cardinal = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
  103. begin
  104.   with HintWnd do
  105.     SetWindowPos(Handle, HWND_TOPMOST, Left, Top, Width, Height,
  106.       Visibility[ShowControl] or SWP_NOACTIVATE)
  107. end;
  108.  
  109. { Move the hint if the form is moved }
  110. procedure TForm1.WMMove(var Msg: TWMMove);
  111. begin
  112.   inherited;
  113.   { If we have a control's tooltip showing }
  114.   if Assigned(Control) then
  115.     with CalcHintTopLeft(Control) do
  116.       { We'll move it }
  117.       MoveWindow(HintWnd.Handle, X, Y, HintWnd.Width, HintWnd.Height, True);
  118. end;
  119.  
  120. procedure TForm1.FormCreate(Sender: TObject);
  121. begin
  122.   { These two ensure the manufactured hints disappear and reappear as appropriate }
  123.   Application.OnActivate := ActivateOnOff;
  124.   Application.OnDeActivate := ActivateOnOff;
  125. end;
  126.  
  127. { Make sure the hint goes away if the form is shrunk so the control is not visible }
  128. procedure TForm1.FormResize(Sender: TObject);
  129. begin
  130.   { If we have a control's tooltip showing }
  131.   if Assigned(Control) then
  132.     { Hide it if the control is no longer visible, else show it }
  133.     MoveControl(HintWnd, PtInRect(
  134.         Rect(0, 0, ClientWidth, ClientHeight),
  135.         Point(Control.Left, Control.Top)))
  136. end;
  137.  
  138. procedure TForm1.btnExitClick(Sender: TObject);
  139. begin
  140.   Application.Terminate
  141. end;
  142.  
  143. { When control gains focus, display the hint }
  144. procedure TForm1.DBEditEnter(Sender: TObject);
  145. var
  146.   HintRect: TRect;
  147. begin
  148.   { Create instance of currently registered hint window class }
  149.   if not Assigned(HintWnd) then
  150.     HintWnd := HintWindowClass.Create(Self);
  151.   { Use current VCL hint colour }
  152.   HintWnd.Color := Application.HintColor;
  153.   Control := TControl(Sender);
  154.   { How big should it be? }
  155.   HintRect := CalcHintRect(Screen.Width, Control.Hint, HintWnd);
  156.   with CalcHintTopLeft(Control) do
  157.     OffsetRect(HintRect, X, Y);
  158.   { Show it }
  159.   HintWnd.ActivateHint(HintRect, Control.Hint)
  160. end;
  161.  
  162. { When control loses focus, remove the hint }
  163. procedure TForm1.DBEditExit(Sender: TObject);
  164. begin
  165.   Control := nil;
  166.   { Keep object, but destroy underlying window }
  167.   HintWnd.ReleaseHandle;
  168. end;
  169.  
  170. end.
  171.